perm filename FFT8X.MAC[SYS,ALS] blob sn#001159 filedate 1972-04-04 generic text, type T, neo UTF8
00010	TITLE	FRXFM
00020	;	  FAST FOURIER TRANSFORM 842 FOR N=2**N2POW
00030	;	THIS PROGRAM REPLACES THE VECTOR Z=X+IY BY ITS FINITE
00040	;	DISCRETE, COMPLEX FOURIER TRANSFORM.  IT PERFORMS AS MANY BASE
00050	;	8 ITERATIONS AS POSSIBLE AND THEN FINISHES WITH A BASE 4
00060	;	ITERATION OR A BASE 2 ITERATION IF NEEDED.
00070	;
00080	;	THE SUBROUTINE IS CALLED AS SUBROUTINE FRXFM(N2POW,X,Y)
00090	;	THE INTEGER N2POW (WHERE N=2**N2POW), THE N REAL LOCATION
00100	;	ARRAY X, AND THE N REAL LOCATION ARRAY Y MUST BE SUPPLIED
00110	;	TO THE SUBROUTINE.
00120	;
00130	;	THE EXECUTION TIME OF THE ORIGINAL FORTRAN VERSION OF THIS
00140	;	PROGRAM FOR N=1024 WAS APPROXIMATELY 0.6 SECONDS ON THE
00150	;	G.E. 635 COMPUTER.  THE TIME FOR THE FOLLOWING MACRO VERSION
00160	;	IS 0.45 SECONDS ON THE DIGITAL EQUIPMENT CORPORATION PDP-10,
00170	;	WHERE TIME=50*(N*N2POW) MICROSECONDS.
00180	;
00190	;	THIS WORK MADE USE OF ARPA GRANT AF30(602)-4277 AT THE
00200	;	UNIVERSITY OF UTAH (APRIL, 1970).
00210	;
00220	;	COMMENTS BY D. OESTREICHER (APRIL, 1971)
00230	;	SLIGHT MODIFICATIONS ALSO
00240	;
00250	;	THE VARIABLE NAMES IN THE COMMENTS REFER TO VARIABLE
00260	;	NAMES USED IN THE ABOVE MENTIONED FORTRAN PROGRAM.
00270	;
00280		ENTRY	FRXFM
00290		EXTERN	FLOAT,COS,SIN
00300	FRXFM:	0
00310		MOVEM	17,SAVE+17
00320		MOVE	17,[XWD 0,SAVE]
00330		BLT	17,SAVE+16
00340		MOVE	0,@0(16)
00350		HRRM	0,N2POWA	;INITAILIZE IMMED. CONST. N2POW
00360		HRRM	0,N2POWB	;INITAILIZE IMMED. CONST. N2POW
00370		HRRM	0,N2POWC	;INITAILIZE IMMED. CONST. N2POW
00380		HRRM	0,N2POWD	;INITAILIZE IMMED. CONST. N2POW
00390		MOVE	0,1(16)
00400		HRRM	0,LOP$1	;INITIALIZE IMMED. CONST. PTR TO X ARRAY
00410		HRRM	0,LOP$3	;INITIALIZE IMMED. CONST. PTR TO X ARRAY
00420		HRRM	0,LOP$5	;INITIALIZE IMMED. CONST. PTR TO X ARRAY
00430		SUBI	0,1
00440		MOVEM	0,X#
00450		HRRM	0,R2CR0A
00460		HRRM	0,R2CR0B
00470		HRRM	0,R4CR0A
00480		HRRM	0,R4CR0B
00490		HRRM	0,R8CR0A
00500		HRRM	0,R8CR0B
00510		ADDI	0,1
00520		HRRM	0,R2CR1A
00530		HRRM	0,R2CR1B
00540		HRRM	0,R4CR1A
00550		HRRM	0,R4CR1B
00560		ADDI	0,1
00570		HRRM	0,R4CR2A
00580		HRRM	0,R4CR2B
00590		HRRM	0,R4CR2C
00600		ADDI	0,1
00610		HRRM	0,R4CR3A
00620		HRRM	0,R4CR3B
00630		HRRM	0,R4CR3C
00640		MOVE	0,2(16)
00650		HRRM	0,LOP$2	;INITIALIZE IMMED. CONST. PTR TO Y ARRAY
00660		HRRM	0,LOP$4	;INITIALIZE IMMED. CONST. PTR TO Y ARRAY
00670		HRRM	0,LOP$6	;INITIALIZE IMMED. CONST. PTR TO Y ARRAY
00680		SUBI	0,1
00690		MOVEM	0,Y#
00700		HRRM	0,R2CI0A
00710		HRRM	0,R2CI0B
00720		HRRM	0,R4CI0A
00730		HRRM	0,R4CI0B
00740		HRRM	0,R8CI0A
00750		HRRM	0,R8CI0B
00760		ADDI	0,1
00770		HRRM	0,R2CI1A
00780		HRRM	0,R2CI1B
00790		HRRM	0,R4CI1A
00800		HRRM	0,R4CI1B
00810		ADDI	0,1
00820		HRRM	0,R4CI2A
00830		HRRM	0,R4CI2B
00840		HRRM	0,R4CI2C
00850		ADDI	0,1
00860		HRRM	0,R4CI3A
00870		HRRM	0,R4CI3B
00880		HRRM	0,R4CI3C
00890		MOVEI	0,1
00900	N2POWA:	LSH	0,.-.	;MODIFIED TO CONST. N2POW
00910		HRRM	0,NTHPOA	;INITIALIZE IMMED. CONST. NTHPO
00920		HRRM	0,NTHPOB	;INITIALIZE IMMED. CONST. NTHPO
00930		HRRM	0,NTHPOC	;INITIALIZE IMMED. CONST. NTHPO
00940		HRRM	0,NTHPOD	;INITIALIZE IMMED. CONST. NTHPO
00950	N2POWB:	MOVEI	1,.-.	;MODIFIED TO CONST. N2POW
00960		IDIVI	1,3
00970		HRRM	1,N8POWA	;INITIALIZE IMMED. CONST. N8POW
00980		HRRM	1,N8POWB	;INITIALIZE IMMED. CONST. N8POW
00990		JUMPE	1,P3
01000		MOVEI	15,1
01010	;***ALL CODE ABOVE IS EXECUTED ONLY ONCE AS INITIALIZATION***
     

00010	LOOP1:	MOVEM	15,IPASS#
00020		IMUL	15,[-3]
00030	N2POWC:	ADDI	15,.-.	;MODIFIED TO CONST. N2POW
00040		MOVEI	3,1
00050		LSH	3,@15
00060		MOVEM	3,NXTLT#
00070		SUBI	3,1
00080		HRRM	3,NXTLTA	;INIT. IMMED. VAR. NXTLT-1
00090		ADDI	3,1
00100		ASH	3,3
00110		MOVEM	3,LENGT#
00120		HRRM	3,LENGTA	;INIT. IMMED. VAR. LENGT
00130		JRST	R8TX
00135	
00137	
00140	CONT8:	MOVE	15,IPASS
00150	N8POWA:	CAIGE	15,.-.	;INITED TO IMMED. CONST. N8POW
00160		AOJA	15,LOOP1
00170	P3:
00180	N8POWB:	MOVNI	4,.-.	;INITED TO IMMED. CONST. N8POW
00190		IMULI	4,3
00200	N2POWD:	ADDI	4,.-.	;MODIFIED TO CONST. N2POW
00210		SUBI	4,1
00220		JUMPL	4,P5
00230		JUMPG	4,P7
00240		JRST	R2TX
00250	P7:	JRST	R4TX
00260		JRST	FINISH
00270	
00280	
00290	R2TX:	MOVEI	15,1
00300	R2TXL:
00310	R2CR0A:	MOVE	1,.-.(15)	;	1=CR0
00320	R2CR1A:	MOVE	2,.-.(15)	;	2=CR1
00330	R2CR0B:	FADRM	2,.-.(15)	;	CR0=CR1+CR0
00340	R2CR1B:	FSBRM	1,.-.(15)	;	CR1=CR0-CR1
00350	R2CI0A:	MOVE	1,.-.(15)	;	1=CI0
00360	R2CI1A:	MOVE	2,.-.(15)	;	2=CI2
00370	R2CI0B:	FADRM	2,.-.(15)	;	CI0=CI1+CI0
00380	R2CI1B:	FSBRM	1,.-.(15)	;	CI1=CI0-CI1
00390		ADDI	15,2
00400	NTHPOA:	CAIG	15,.-.	;INITED TO IMMED. CONST. NTHPO
00410		JRST	R2TXL
00420		JRST	P5
00430	
00440	
00450	R4TX:	MOVEI	15,1
00460	R4TXL:
00470	R4CR0A:	MOVE	1,.-.(15)	;	1=CR0
00480	R4CR2A:	FADR	1,.-.(15)	;	1=R1=CR0+CR2
00490	R4CR1A:	MOVE	2,.-.(15)	;	2=CR1
00500	R4CR3A:	FADR	2,.-.(15)	;	2=R3=CR1+CR3
00510	R4CI0A:	MOVE	3,.-.(15)	;	3=CI0
00520	R4CI2A:	FADR	3,.-.(15)	;	3=FI1=CI0+CI2
00530	R4CI1A:	MOVE	4,.-.(15)	;	4=CI1
00540	R4CI3A:	FADR	4,.-.(15)	;	4=FI3=CI1+CI3
00550		MOVE	5,1		;	5=R1
00560		FADR	5,2		;**	5=CR0=R1+R3
00570		FSBR	1,2		;**	1=CR1=R1-R3
00580		MOVE	2,3		;	2=FI1
00590		FADR	2,4		;**	2=CI0=FI1+FI3
00600		FSBR	3,4		;**	3=CI1=FI1-FI3
00610	R4CR0B:	EXCH	5,.-.(15)	;*	5=CR0
00620	R4CR1B:	EXCH	1,.-.(15)	;*	1=CR1
00630	R4CI0B:	EXCH	2,.-.(15)	;*	2=CI0
00640	R4CI1B:	EXCH	3,.-.(15)	;*	3=CI1
00650	R4CR2B:	FSBR	5,.-.(15)	;	5=R2=CR0-CR2
00660	R4CR3B:	FSBR	1,.-.(15)	;	1=R4=CR1-CR3
00670	R4CI2B:	FSBRB	2,.-.(15)	;	2=CI2=FI2=CI0-CI2
00680	R4CI3B:	FSBR	3,.-.(15)	;	3=FI4=CI1-CI3
00690		MOVE	4,5		;	4=R2
00700		FSBR	4,3		;**	4=CR2=R2-FI4
00710		FADR	5,3		;**	5=CR3=R2+FI4
00720	R4CI2C:	FADRM	1,.-.(15)	;*CI2=R4+FI2
00730		FSBR	2,1		;**	2=CI3=FI2-R4
00740	R4CR2C:	MOVEM	4,.-.(15)	;*	4=CR2
00750	R4CR3C:	MOVEM	5,.-.(15)	;*	5=CR3
00760	R4CI3C:	MOVEM	2,.-.(15)	;*	2=CI3
00770		ADDI	15,4
00780	NTHPOB:	CAIG	15,.-.		;INITED TO IMMED. CONST. NTHPO
00790		JRST	R4TXL
00800		JRST	P5
00810	
00820	
00830	R8TX:	MOVE	0,X
00840		ADD	0,NXTLT
00850		HRRM	0,R8CR1A
00860		HRRM	0,R8CR1B
00870		ADD	0,NXTLT
00880		HRRM	0,R8CR2A
00890		HRRM	0,R8CR2B
00900		ADD 	0,NXTLT
00910		HRRM	0,R8CR3A
00920		HRRM	0,R8CR3B
00930		ADD	0,NXTLT
00940		HRRM	0,R8CR4A
00950		HRRM	0,R8CR4B
00960		HRRM	0,R8CR4C
00970		ADD	0,NXTLT
00980		HRRM	0,R8CR5A
00990		HRRM	0,R8CR5B
01000		HRRM	0,R8CR5C
01010		ADD	0,NXTLT
01020		HRRM	0,R8CR6A
01030		HRRM	0,R8CR6B
01040		HRRM	0,R8CR6C
01050		ADD	0,NXTLT
01060		HRRM	0,R8CR7A
01070		HRRM	0,R8CR7B
01080		HRRM	0,R8CR7C
01090		MOVE	0,Y
01100		ADD	0,NXTLT
01110		HRRM	0,R8CI1A
01120		HRRM	0,R8CI1B
01130		ADD	0,NXTLT
01140		HRRM	0,R8CI2A
01150		HRRM	0,R8CI2B
01160		ADD	0,NXTLT
01170		HRRM	0,R8CI3A
01180		HRRM	0,R8CI3B
01190		ADD	0,NXTLT
01200		HRRM	0,R8CI4A
01210		HRRM	0,R8CI4B
01220		HRRM	0,R8CI4C
01230		ADD	0,NXTLT
01240		HRRM	0,R8CI5A
01250		HRRM	0,R8CI5B
01260		HRRM	0,R8CI5C
01270		ADD	0,NXTLT
01280		HRRM	0,R8CI6A
01290		HRRM	0,R8CI6B
01300		HRRM	0,R8CI6C
01310		ADD	0,NXTLT
01320		HRRM	0,R8CI7A
01330		HRRM	0,R8CI7B
01340		HRRM	0,R8CI7C
01350		MOVE	4,[6.283185307]
01360		JSA	16,FLOAT	;ONE OF TWO CALLS ON FLOAT
01370		ARG	LENGT
01380		FDVR	4,0
01390		MOVEM	4,SCALE#
01400	
01410	;ACCUMULATORS
01420	AC0=0
01430	AC1=1
01440	AC2=2
01450	AC3=3
01460	AC4=4
01470	AC5=5
01480	AC6=6
01490	AC7=7
01500	AC10=10
01510	AC11=11
01520	AC12=12
01530	AC13=13
01540	ACJ=14
01550	ACK=15
01560	ACR2=16
01570	ACMR2=17
01580	
01590		MOVEI	ACJ,0	;INIT J
01600		MOVE	ACR2,[0.7071067812]	;SETUP ACR2
01610		MOVN	ACMR2,ACR2	;SETUP ACMR2
01620		MOVEI	ACK,1(ACJ)	;SETUP K
01630		JRST	LOOPK	;FAST START
01640	
01650	LOOPJ:	MOVEM	ACJ,J#	;SAVE J
01660		FSC	ACJ,233	;FLOAT J
01670		FMPR	ACJ,SCALE	;MAKE ANGLE
01680		MOVEM	ACJ,ARGUM#	;SAVE FOR SIN AND COS
01690		JSA	16,COS
01700		ARG	ARGUM
01710		MOVEM	0,C1#
01720		JSA	16,SIN
01730		ARG	ARGUM
01740		MOVEM	0,S1#
01750		;AC0=S1
01760		MOVE	AC1,AC0	;	AC1=S1
01770		MOVE	AC2,AC1	;	AC2=S1
01780		MOVE	AC3,C1	;	AC3=C1
01790		MOVE	AC4,AC3	;	AC4=C1
01800		MOVE	AC5,AC4	;	AC5=C1
01810		MOVE	AC6,AC5	;	AC6=C1
01820		FMPR	AC3,AC0	;	AC3=S1*C1
01830		FADR	AC3,AC3	;	AC3=S2=2*S1*C1
01840		MOVEM	AC3,S2#	;STORE
01850		FMPR	AC0,AC1	;	AC0=S1*S1
01860		FMPR	AC4,AC5	;	AC4=C1*C1
01870		FSBRB	AC4,AC0	;	AC0=AC4=C2=C1*C1-S1*S1
01880		MOVEM	AC0,C2#	;STORE
01890		FMPR	AC2,AC0	;	AC2=S1*C2
01900		FMPR	AC6,AC3	;	AC6=C1*S2
01910		FADRB	AC2,AC6	;	AC2=AC6=S3=S1*C2+C1*S2
01920		MOVEM	AC2,S3#	;STORE
01930		FMPR	AC5,AC0	;	AC5=C1*C2
01940		FMPR	AC1,AC3	;	AC1=S1*S2
01950		FSBRB	AC5,AC1	;	AC5=AC1=C3=C1*C2-S1*S2
01960		MOVEM	AC5,C3#	;STORE
01970		MOVE	AC7,AC3	;	AC7=S2
01980		FMPR	AC7,AC1	;	AC7=S2*C3
01990		FMPR	AC2,AC0	;	AC2=S3*C2
02000		FADR	AC7,AC2	;	AC7=S5=S2*C3+S3*C2
02010		MOVEM	AC7,S5#	;STORE
02020		MOVE	AC7,AC3	;	AC7=S2
02030		MOVE	AC2,AC0	;	AC2=C2
02040		FMPR	AC2,AC5	;	AC2=C2*C3
02050		FMPR	AC7,AC6	;	AC7=S2*S3
02060		FSBR	AC2,AC7	;	AC2=C5=C2*C3-S2*S3
02070		MOVEM	AC2,C5#	;STORE
02080		FMPR	AC4,AC3	;	AC4=C2*S2
02090		FADR	AC4,AC4	;	AC4=S4=2*C2*S2
02100		MOVEM	AC4,S4#	;STORE
02110		FMPR	AC0,AC0	;	AC0=C2*C2
02120		FMPR	AC3,AC3	;	AC3=S2*S2
02130		FSBRB	AC0,AC3	;	AC0=AC3=C4=C2*C2-S2*S2
02140		MOVEM	AC0,C4#	;STORE
02150		MOVE	AC7,AC4	;	AC7=S4
02160		FMPR	AC3,AC6	;	AC3=C4*S3
02170		FMPR	AC7,AC5	;	AC7=S4*C3
02180		FADR	AC3,AC7	;	AC3=S7=C4*S3+S4*C3
02190		MOVEM	AC3,S7#	;STORE
02200		FMPR	AC0,AC5	;	AC0=C4*C3
02210		FMPR	AC4,AC6	;	AC4=S4*S3
02220		FSBR	AC0,AC4	;	AC0=C7=C4*C3-S4*S3
02230		MOVEM	AC0,C7#	;STORE
02240		FMPR	AC1,AC6	;	AC1=C3*S3
02250		FADR	AC1,AC1	;	AC1=S6=2*C3*S3
02260		MOVEM	AC1,S6#	;STORE
02270		FMPR	AC5,AC5	;	AC5=C3*C3
02280		FMPR	AC6,AC6	;	AC6=S3*S3
02290		FSBR	AC5,AC6	;	AC5=C6=C3*C3-S3*S3
02300		MOVEM	AC5,C6#	;STORE
02310		MOVE	ACJ,J	;RESET J
02320		MOVE	ACR2,[0.7071067812]	;RESET ACR2
02330		MOVN	ACMR2,ACR2	;SETUP ACMR2
02340		MOVEI	ACK,1(ACJ)	;SETUP K
02350	
02360	LOOPK:
02370	;INNER-MOST LOOP F0R RADIX 8 ITERATI0N
02380	R8CR0A:	MOVE	AC0,.-.(ACK)	;CR0+CR4
02390	R8CR4A:	FADR	AC0,.-.(ACK)	;	AC0=AR0
02400	R8CR1A:	MOVE	AC1,.-.(ACK)	;CR1+CR5
02410	R8CR5A:	FADR	AC1,.-.(ACK)	;	AC1=AR1
02420	R8CR2A:	MOVE	AC2,.-.(ACK)	;CR2+CR6
02430	R8CR6A:	FADR	AC2,.-.(ACK)	;	AC2=AR2
02440	R8CR3A:	MOVE	AC3,.-.(ACK)	;CR3+CR7
02450	R8CR7A:	FADR	AC3,.-.(ACK)	;	AC3=AR3
02460	R8CI0A:	MOVE	AC4,.-.(ACK)	;CI0+CI4
02470	R8CI4A:	FADR	AC4,.-.(ACK)	;	AC4=AI0
02480	R8CI1A:	MOVE	AC5,.-.(ACK)	;CI1+CI5
02490	R8CI5A:	FADR	AC5,.-.(ACK)	;	AC5=AI1
02500	R8CI2A:	MOVE	AC6,.-.(ACK)	;CI2+CI6
02510	R8CI6A:	FADR	AC6,.-.(ACK)	;	AC6=AI2
02520	R8CI3A:	MOVE	AC7,.-.(ACK)	;CI3+CI7
02530	R8CI7A:	FADR	AC7,.-.(ACK)	;	AC7=AI3
02540		MOVE	AC10,AC0	;	AC10=AR0
02550		MOVE	AC11,AC1	;	AC11=AR1
02560		MOVE	AC12,AC4	;	AC12=AI0
02570		MOVE	AC13,AC5	;	AC13=AI1
02580		FADR	AC10,AC2	;	AC10=BR0=AR0+AR2
02590		FSBR	AC11,AC3	;	AC11=BR3=AR1-AR3
02600		FADR	AC12,AC6	;	AC12=BI0=AI0+AI2
02610		FSBR	AC13,AC7	;	AC13=BI3=AI1-AI3
02620		FSBRB	AC0,AC2		;	AC0=AC2=BR2=AR0-AR2
02630		FADRB	AC1,AC3		;	AC1=AC3=BR1=AR1+AR3
02640		FSBRB	AC4,AC6		;	AC4=AC6=BI2=AI0-AI2
02650		FADRB	AC5,AC7		;	AC5=AC7=BI1=AI1+AI3
02660		FADR	AC1,AC10	;**	AC1=CR0=BR1+BR0
02670		FADR	AC5,AC12	;**	AC5=CI0=BI1+BI0
02680		JUMPE	ACJ,R8J0A	;J=0	SPECIAL CASE
02690		FSBRB	AC12,AC7	;	AC12=AC7=BI0-BI1
02700		FSBRB	AC10,AC3	;	AC10=AC3=BR0-BR1
02710		FMPR	AC10,C4		;	AC10=C4*(BR0-BR1)
02720		FMPR	AC3,S4		;	AC3=S4*(BR0-BR1)
02730		FMPR	AC12,C4		;	AC12=C4*(BI0-BI1)
02740		FMPR	AC7,S4		;	AC7=S4*(BI0-BI1)
02750		FSBR	AC10,AC7	;**	AC10=CR1
02760		FADR	AC12,AC3	;**	AC12=CI1
02770		FSBR	AC0,AC13	;	AC0=BR2-BI3
02780		MOVE	AC7,AC0		;=AC7
02790		FADRB	AC2,AC13	;	AC2=AC13=BR2+BI3
02800		FSBR	AC4,AC11	;	AC4=BI2-BR3
02810		MOVE	AC3,AC4		;=AC3
02820		FADRB	AC6,AC11	;	AC6=AC11=BI2+BR3
02830		FMPR	AC0,C2		;	AC0=C2*(BR2-BI3)
02840		FMPR	AC6,S2		;	AC6=S2*(BI2+BR3)
02850		FMPR	AC11,C2		;	AC11=C2*(BI2+BR3)
02860		FMPR	AC7,S2		;	AC7=S2*(BR2-BI3)
02870		FMPR	AC13,C6		;	AC13=C6*(BR2+BI3)
02880		FMPR	AC3,S6		;	AC3=S6*(BI2-BR3)
02890		FMPR	AC4,C6		;	AC4=C6*(BI2-BR3)
02900		FMPR	AC2,S6		;	AC2=S6*(BR2+BI3)
02910		FSBR	AC0,AC6		;**	AC0=CR2
02920		FADR	AC11,AC7	;**	AC11=CI2
02930		FSBR	AC13,AC3	;**	AC13=CR3
02940		FADR	AC4,AC2		;**	AC4=CI3
02950	R8JXA:
02960	R8CR0B:	EXCH	AC1,.-.(ACK)	;*	AC1=CR0
02970	R8CR1B:	EXCH	AC10,.-.(ACK)	;*	AC10=CR1
02980	R8CR2B:	EXCH	AC0,.-.(ACK)	;*	AC0=CR2
02990	R8CR3B:	EXCH	AC13,.-.(ACK)	;*	AC13=CR3
03000	R8CI0B:	EXCH	AC5,.-.(ACK)	;*	AC5=CI0
03010	R8CI1B:	EXCH	AC12,.-.(ACK)	;*	AC12=CI1
03020	R8CI2B:	EXCH	AC11,.-.(ACK)	;*	AC11=CI2
03030	R8CI3B:	EXCH	AC4,.-.(ACK)	;*	AC4=CI3
03040	R8CR4B:	FSBR	AC1,.-.(ACK)	;	AC1=AR4
03050	R8CR5B:	FSBR	AC10,.-.(ACK)	;	AC10=AR5
03060	R8CR6B:	FSBR	AC0,.-.(ACK)	;	AC0=AR6
03070	R8CR7B:	FSBR	AC13,.-.(ACK)	;	AC13=AR7
03080	R8CI4B:	FSBR	AC5,.-.(ACK)	;	AC5=AI4
03090	R8CI5B:	FSBR	AC12,.-.(ACK)	;	AC12=AI5
03100	R8CI6B:	FSBR	AC11,.-.(ACK)	;	AC11=AI6
03110	R8CI7B:	FSBR	AC4,.-.(ACK)	;	AC4=AI7
03120		MOVE	AC2,AC1		;	AC2=AR4
03130		MOVE	AC3,AC10	;	AC3=AR5
03140		MOVE	AC6,AC5		;	AC6=AI4
03150		MOVE	AC7,AC12	;	AC7=AI5
03160		FADR	AC1,AC11	;	AC1=BR6=AR4+AI6
03170		FSBRB	AC2,AC11	;	AC2=AC11=BR4=AR4-AI6
03180		FADR	AC3,AC4		;	AC3=BR7=AR5+AI7
03190		FSBRB	AC10,AC4	;	AC4=AC10=BR5=AR5-AI7
03200		FSBR	AC6,AC0		;	AC6=BI6=AI4-AR6
03210		FADRB	AC5,AC0		;	AC5=AC0=BI4=AI4+AR6
03220		FSBR	AC7,AC13	;	AC7=BI7=AI5-AR7
03230		FADR	AC12,AC13	;	AC12=BI5=AI5+AR7
03240		FSBR	AC4,AC12	;	AC4=BR5-BI5
03250		FADR	AC10,AC12	;	AC10=BR5+BI5
03260		FMPR	AC4,ACR2	;	AC4=TR5
03270		FMPR	AC10,ACR2	;	AC10=TI5
03280		MOVE	AC12,AC3	;	AC12=BR7
03290		FADR	AC12,AC7	;	AC12=BR7+BI7
03300		FSBR	AC3,AC7		;	AC3=BR7-BI7
03310		FMPR	AC12,ACMR2	;	AC12=TR7
03320		FMPR	AC3,ACR2	;	AC3=TI7
03330		JUMPE	ACJ,R8J0B	;J=0	SPECIAL CASE
03340		FADR	AC2,AC4		;	AC2=BR4+TR5
03350		MOVE	AC7,AC2		;=AC7
03360		FSBRB	AC11,AC4	;	AC11=AC4=BR4-TR5
03370		FADR	AC5,AC10	;	AC5=BI4+TI5
03380		MOVE	AC13,AC5	;=AC13
03390		FSBRB	AC0,AC10	;	AC0=AC10=BI4-TI5
03400		FMPR	AC2,C1		;	AC2=C1*(BR4+TR5)
03410		FMPR	AC13,S1		;	AC13=S1*(BI4+TI5)
03420		FMPR	AC5,C1		;	AC5=C1*(BI4+TI5)
03430		FMPR	AC7,S1		;	AC7=S1*(BR4+TR5)
03440		FMPR	AC11,C5		;	AC11=C5*(BR4-TR5)
03450		FMPR	AC10,S5		;	AC10=S5*(BI4-TI5)
03460		FMPR	AC0,C5		;	AC0=C5*(BI4-TI5)
03470		FMPR	AC4,S5		;	AC4=S5*(BR4-TR5)
03480		FSBR	AC2,AC13	;**	AC2=CR4
03490		FADR	AC5,AC7		;**	AC5=CI4
03500		FSBR	AC11,AC10	;**	AC11=CR5
03510		FADR	AC0,AC4		;**	AC0=CI5
03520		MOVE	AC4,AC1		;	AC4=BR6
03530		MOVE	AC7,AC6		;	AC7=BI6
03540		FADR	AC1,AC12	;	AC1=BR6+TR7
03550		MOVE	AC13,AC1	;=AC13
03560		FADR	AC6,AC3		;	AC6=BI6+TI7
03570		MOVE	AC10,AC6	;=AC10
03580		FSBRB	AC4,AC12	;	AC4=AC12=BR6-TR7
03590		FSBRB	AC7,AC3		;	AC7=AC3=BI6-TI7
03600		FMPR	AC1,C3		;	AC1=C3*(BR6+TR7)
03610		FMPR	AC10,S3		;	AC10=S3*(BI6+TI7)
03620		FMPR	AC6,C3		;	AC6=C3*(BI6+TI7)
03630		FMPR	AC13,S3		;	AC13=S3*(BR6+TR7)
03640		FMPR	AC4,C7		;	AC4=C7*(BR6-TR7)
03650		FMPR	AC3,S7		;	AC3=S7*(BI6-TI7)
03660		FMPR	AC7,C7		;	AC7=C7*(BI6-TI7)
03670		FMPR	AC12,S7		;	AC12=S7*(BR6-TR7)
03680		FSBR	AC1,AC10	;**	AC1=CR6
03690		FADR	AC6,AC13	;**	AC6=CI6
03700		FSBR	AC4,AC3		;**	AC4=CR7
03710		FADR	AC7,AC12	;**	AC7=CI7
03720	R8JXB:
03730	R8CR4C:	MOVEM	AC2,.-.(ACK)	;*	AC2=CR4
03740	R8CR5C:	MOVEM	AC11,.-.(ACK)	;*	AC11=CR5
03750	R8CR6C:	MOVEM	AC1,.-.(ACK)	;*	AC1=CR6
03760	R8CR7C:	MOVEM	AC4,.-.(ACK)	;*	AC4=CR7
03770	R8CI4C:	MOVEM	AC5,.-.(ACK)	;*	AC5=CI4
03780	R8CI5C:	MOVEM	AC0,.-.(ACK)	;*	AC0=CI5
03790	R8CI6C:	MOVEM	AC6,.-.(ACK)	;*	AC6=CI6
03800	R8CI7C:	MOVEM	AC7,.-.(ACK)	;*	AC7=CI7
03810	LENGTA:	ADDI	ACK,.-.		;INITED TO IMMED. VAR. LENGT BY LOOP1
03820	NTHPOC:	CAIG	ACK,.-.		;INITED TO IMMED. CONST. NTHPO
03830		JRST	LOOPK		;LOOP
03840	NXTLTA:	CAIGE	ACJ,.-.		;INITED TO IMMED. VAR. NXTLT-1 BY LOOP1
03850		AOJA	ACJ,LOOPJ	;LOOP
03860		JRST	CONT8		;CONTINUE
03870	
03880	
03890	;J=0	SPECIAL CASE	A
03900	R8J0A:
03910		FSBR	AC10,AC3	;**	AC10=CR1=BR0-BR1
03920		FSBR	AC12,AC7	;**	AC12=CI1=BI0-BI1
03930		FSBR	AC0,AC13	;**	AC0=CR2=BR2-BI3
03940		FSBR	AC4,AC11	;**	AC4=CI3=BI2-BR3
03950		FADR	AC11,AC6	;**	AC11=CI2=BR3+BI2
03960		FADR	AC13,AC2	;**	AC13=CR3=BI3+BR2
03970		JRST	R8JXA		;CONTINUE
03980	
03990	;J=0	SPECIAL CASE	B
04000	R8J0B:
04010		FADR	AC2,AC4	;**	AC2=CR4=BR4+TR5
04020		FADR	AC5,AC10	;**	AC5=CI4=BI4+TI5
04030		FSBR	AC11,AC4	;**	AC11=CR5=BR4-TR5
04040		FSBR	AC0,AC10	;**	AC0=CI5=BI4-TI5
04050		MOVE	AC4,AC1		;	AC4=BR6
04060		MOVE	AC7,AC6		;	AC7=BI6
04070		FADR	AC1,AC12	;**	AC1=CR6=BR6+TR7
04080		FADR	AC6,AC3		;**	AC6=CI6=BI6+TI7
04090		FSBR	AC4,AC12	;**	AC4=CR7=BR6-TR7
04100		FSBR	AC7,AC3		;**	AC7=CI7=BI6-TI7
04110		JRST	R8JXB		;CONTINUE
04120	
04130	P5:
04140	NTHPOD:	MOVEI	1,.-.	;INITED TO IMMED. CONST. NTHPO
04150		SUBI	1,1
04160		MOVE	2,1
04170		MOVE	3,1
04180		SUBI	2,1
04190	LOOP:	JFFO	3,.+1
04200		XOR	3,TABLE-25(4)
04210		AND	3,1
04220		CAMG	3,2
04230		JRST	BD2
04240	LOP$1:	MOVE	5,.-.(3)	;INITED TO IMMED. CONST. PTR TO X ARRAY
04250	LOP$2:	MOVE	7,.-.(3)	;INITED TO IMMED. CONST. PTR TO Y ARRAY
04260	LOP$3:	EXCH	5,.-.(2)	;INITED TO IMMED. CONST. PTR TO X ARRAY
04270	LOP$4:	EXCH	7,.-.(2)	;INITED TO IMMED. CONST. PTR TO Y ARRAY
04280	LOP$5:	MOVEM	5,.-.(3)	;INITED TO IMMED. CONST. PTR TO X ARRAY
04290	LOP$6:	MOVEM	7,.-.(3)	;INITED TO IMMED. CONST. PTR TO Y ARRAY
04300	BD2:	SOJG	2,LOOP
04310	FINISH:	MOVE	17,[XWD SAVE,0]
04320		BLT	17,17
04330		JRA	16,3(16)
04340	
04350	TABLE:	↑B111111111111111111111100000000000000
04360		↑B111111111111111111111110000000000000
04370	        ↑B111111111111111111111111000000000000
04380		↑B111111111111111111111111100000000000
04390		↑B111111111111111111111111110000000000
04400		↑B111111111111111111111111111000000000
04410		↑B111111111111111111111111111100000000
04420		↑B111111111111111111111111111110000000
04430		↑B111111111111111111111111111111000000
04440		↑B111111111111111111111111111111100000
04450		↑B111111111111111111111111111111110000
04460		↑B111111111111111111111111111111111000
04470		↑B111111111111111111111111111111111100
04480		↑B111111111111111111111111111111111110
04490		↑B111111111111111111111111111111111111
04500	SAVE:	BLOCK	20
04510		END